home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1993…stman Always Clicks Twice / ADC Developer CD (1993-01) (''The Postman Always Clicks Twice'')_iso / Dev.CD 199301.iso / Development Platforms / LISP Related / LISP Goodies / GETA Browser v1.01 / GETA-Browser.lisp next >
Encoding:
Text File  |  1992-09-02  |  2.2 KB  |  81 lines  |  [TEXT/CCL2]

  1.  
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;  GETA-browser.lisp
  4. ;;
  5. ;;
  6. ;;   1992, GETA
  7. ;;  
  8. ;;  For contact : Mathieu Lafourcade
  9. ;;                GETA-Imag
  10. ;;                150, rue de la Chimie
  11. ;;                BP 53X
  12. ;;                38041 Grenoble Cedex, France
  13. ;;                e-mail : lafourca@imag.fr (internet)
  14. ;;
  15. ;;  Load the GETA-browser package
  16. ;;
  17.  
  18. (in-package :ccl)
  19.  
  20. ; load our files
  21.  
  22. (unless (find-package :geta-browser)
  23.   (defpackage :geta-browser 
  24.     (:use :common-lisp :ccl)
  25.     (:export :browse-class)))
  26.     
  27.  
  28. (defparameter *geta-browser-loaded?* nil "If T, browser has been loaded")
  29.  
  30. (defparameter *geta-browser-host* "ccl")
  31. (defparameter *geta-browser-directory* "GETA-Browser Folder;Browser;")
  32.  
  33. (defparameter *geta-browser-files*
  34.          '("Standard-node"
  35.            "Class-node"
  36.            "Grapher"
  37.            "CLOS-Grapher"
  38.            "Node-menu"
  39.  
  40.            ;; these files are only required if you want
  41.            ;; to browse more than classes
  42.            "Class-leaf-node"
  43.            "Slot&Method-node"
  44.  
  45.            ;; for installation
  46.            "Class-browser-dialog"
  47.            ))
  48.  
  49. (defun compile-geta-browser ()
  50.   (dolist (file *geta-browser-files*)
  51.       (let ((filename (make-pathname :host *geta-browser-host*
  52.                                      :directory *geta-browser-directory*
  53.                                      :name file)))
  54.         (format t "~% Compiling ~a..." filename)
  55.         (compile-file filename))))
  56.  
  57. (defun load-geta-browser ()
  58.   (unless *geta-browser-loaded?*
  59.     (dolist (file *geta-browser-files*)
  60.       (let ((filename (make-pathname :host *geta-browser-host*
  61.                                      :directory *geta-browser-directory*
  62.                                      :name file)))
  63.         (format t "~% Loading ~a..." filename)
  64.         (load filename)))
  65.     (setf *geta-browser-loaded?* t)))
  66.       
  67.     
  68. ; (compile-geta-browser)  ; Try this before loading GETA-browser
  69.  
  70. (load "ccl:Library;QuickDraw")
  71. (load-geta-browser)
  72.  
  73. ; the function to be exported
  74. (defun browse-class (class)
  75.   (GETA-Browser::browse-class (find-class class))
  76.   )
  77.  
  78. ;; (time (ccl::browse-class 'geta-browser::node))
  79. ;; (time (ccl::browse-class t))
  80.  
  81.